home *** CD-ROM | disk | FTP | other *** search
/ HPAVC / HPAVC CD-ROM.iso / pc / PINBSRC.ZIP / PINBALL.PAS < prev    next >
Encoding:
Pascal/Delphi Source File  |  1996-02-02  |  2.7 KB  |  117 lines
  1. {                         ****************************
  2.                       ****   PC Spiel Pinball SOURCE  ****
  3.                           ****************************
  4.  
  5.   FILE DESCRIPTION: This is the main program, from whom all is starting.
  6.  
  7.   Read the file readme. for further information.
  8.  
  9. }
  10.  
  11. {$M $4000,0,0 }
  12.  
  13. uses dos,crt;
  14.  
  15. const N1 = ' PCS-PINBALL  - Version 1.1 written by A.Scherp and J.Gelhaus ';
  16.       N2 = ' (c)opyrights reserved by PC Spiel and vIRTUAL tECHNOLOGIES GbR';
  17.  
  18. var params:string;
  19.     code:integer;
  20.     music,highres,overscan,player,tables:byte;
  21.     path:string;
  22.     hilfsb:byte;
  23.  
  24. {$M $4000,0,0 }
  25. Procedure Switch_Cursor(c:boolean);
  26. var r: registers;
  27. begin
  28.  r.ax:=$0100;
  29.  if c then r.cx:=$0506 else r.cx:=$2607;
  30.  intr($10,r);
  31. end;
  32.  
  33. function IntToStr(I: Longint): String;
  34. var  S: string[11];
  35. begin
  36.   Str(I, S);
  37.   IntToStr := S;
  38. end;
  39.  
  40. procedure abort;
  41. begin
  42.   switch_cursor(true);
  43.   clrscr;
  44.   writeln('ASM-PINBALL is not able to run');
  45.   halt(1);
  46. end;
  47.  
  48. procedure decode_paras;
  49. var i:byte;
  50. begin
  51.   val(params,i,code);
  52.   if I and 64 = 64 then tables:=2   else tables:=1;
  53.   if i and 32 = 32 then music:=1    else music:=0;
  54.   if i and 16 = 16 then highres:=1  else highres:=0;
  55.   if i and  8 =  8 then overscan:=1 else overscan:=0;
  56.   player:=i and 7;
  57. end;
  58.  
  59. procedure code_paras;
  60. var i:byte;
  61. begin
  62.   i:=0;
  63.   if tables  = 2 then i:=i or 64;
  64.   if music   = 1 then i:=i or 32;
  65.   if highres = 1 then i:=i or 16;
  66.   if overscan= 1 then I:=i or  8;
  67.   i:=I or player;
  68.   params:=IntToStr(i);
  69. end;
  70.  
  71.   var a : string;
  72.  
  73. begin
  74.   CheckBreak := False;
  75.   path:=paramstr(0);
  76.   a := paramstr(1);
  77.   for hilfsb := 1 to length(paramstr(1)) do
  78.       a[hilfsb] := upcase(a[hilfsb]);
  79.   hilfsb:=0;
  80.   while pos('\',copy(path,length(path)-hilfsb,1))=0 do inc(hilfsb);
  81.   path:=(copy(path,1,length(path)-hilfsb-1));
  82.   if a <> '-NOINTRO' then begin
  83.       swapvectors;
  84.       Exec(path+'\INTRO.EXE',paramstr(1));
  85.       swapvectors;
  86.       if DosExitCode <> 100 then begin
  87.            writeln('Intro konnte nicht geladen werden.');
  88.            halt(0);
  89.          end;
  90.     end;
  91.   highres:=0;
  92.   music:=1;
  93.   player:=1;
  94.   tables:=2;
  95.   overscan:=1;
  96.   repeat
  97.     code_paras;
  98.     switch_cursor(false);
  99.     swapvectors;
  100.       Exec(path+'\FLIPPERM.EXE', 'START '+params);
  101.     swapvectors;
  102.     if doserror<>0 then abort;
  103.     code:=DosExitCode;
  104.     params:=IntToStr(Code);
  105.     decode_paras;
  106.     if player>0 then begin
  107.       params:=inttostr(highres+overscan*2)+
  108.               inttostr(music)+inttostr(player);
  109.       switch_cursor(false);
  110.       swapvectors;
  111.         Exec(path+'\FlIpPer'+inttostr(tables)+'.EXE', params+' ');
  112.       swapvectors;
  113.       if doserror<>0 then abort;
  114.     end;
  115.   until player=0;
  116.   switch_cursor(true);
  117. end.